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MODULE purge ( 00!, ! Purge directory program 


DENT 
ADDRESSING. MODE (EXTERNAL=GENERAL) 


5 
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FACILITY: PURGE Command 


! ABSTRACT: 


= 
MEAN =O OOBNAVESUN “OOONOUS 


This utility purges a directory, basi 


s 
old versions of a specified group of 
i ENVIRONMENT : 


vomayeg 


cal 
files 


ly 
25 
VAX/VMS operating system. unprivileged user mode, 


i 
' 
t 
4 
4 
‘ 
1 
] 
4 
; AUTHOR: Tim Halvorsen, — CREATION DATE: Oct-1979 
; Modified by: 
‘ 
‘ 
‘ 
t 
‘ 
4 
‘ 
‘ 
' 
i] 
‘ 


NOUESWN—O0OM@ 


v03-007 SH20009 Stephen H. Zalewksi 15-Mar-1984 
Modify PURGE = hm to make sticky searchlists work. 


v03-006 $H20008 Step phen H. Zalewski, 21-Feb-1984 
Add support for sticky searchlists. 


v03-005 $HZ0007 Stephen H. Zalewski, 27-Dec-1983 

Re _tereylt ing of file name and type in module PURGE FILES. 
anes ormance enh ncement that cuts down on the number 

of A ys SOPEN's and SCLOSE's that must be done to purge 


ssssssssssesssssosessossosse 


SSSSSSSss 
NOUS WO OO 


kt a a tk a ed kt td 8 a a 8 st a tt a OOD 
- 
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<wv 


net a a 8 Ss a a tt 
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v03-004 $HZ0006 Stephen H. Zalewski gsr eb-19 
f PURGE command wee ssued on ODS-2 d go not ceute the 
ilenames before attempting to en hy he’ files. 


v03-003 par 005 Stephen H. Zalewski, 46-Nov-1982 15:42 
Modify PURGE to use common command qualifier package. 


v03-002 puz0006 off"? phen H. Zoloysh i, aecvi® tie 22:19 
Ay 4 in SHZ20 that coy oe gunee o ACCVIO if wed 4 purged 

directory. meee bug thet Gpused No 

purged’ message to be pr nted- An. when files were Mai. | 


Fix introdus ed in $HZ0003 that Eeayentes dangling directory 
entr te s from be being deleted if the PURGE comand was issued 
with 706 qualifier. 


Finally, if a file is opened because : /SINCE, /BEFORE or 
/LOG qualifiers being present, leave pen until we actually 

delete it to optimize the number of FAL obs necessary to do 
the job in case we are doing this over the net. 


v03-001 sxz000S Stephen H. Zalewski, 10-Aug-1982 21:24 


lea error handling. Modified routines to use new CLI. 
Made. Py GE/LOG also display size of file purged. 
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ROPSPOPOROPOPoPOPoNonTrofy 


ey *SYS Ll BRAR 
FORWARD R Tine 


Surhe: ods 
purge_ “this~ 


exter, ROUTINE 
\Ssearch_error : 
atite error : 
$file. 


del 
refs 
b 
b$cv ta tb, 
b 
b 
b 


EXTERNAL 
scan_context, 
del$cli _Status: 
del$keepver_val, 
del$files gfeletes. 
del$file 
delSblocks deletes, 
del$con ones 
Libs -quie 

Libs_ Witeteets 


GLOBAL 
version_list : 


versions : 
prev. name_len : 
prev_name : 
prev_dir_ Len : 
prev_dir': 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


Y:STAR 
QUIRE ‘SRCS:DELETE.REQ’ 


$fr 
Hie “file match; 


ET.L32°; 


oe 


NOVALUE, 


tor "wo 3 NOVALUE, 


NVALUE: 


NOVALUE, 
NOVALUE, 


INITIAL(O); 


b-Fep-1984 3 


VAX=11 BLiss-32_V4.0-762 p | 

DISKSVMSMASTER = (DELETE. SRCJPURGE B32: 1" a 
! VAX/VMS common definitions 
' Common DELETE definitions 


Main directory routine 
Process each wildcard file for ods-1 disk 
Purge v vers ons for a directory 
purge files for ODS-2 disk. 

Routine to delete a file. 


Report open/search error. 

Report RMS error messages 

Search wildcard specifications 

Mark file for erase-on-delete 

Convert decimal string to binary 
Allocate dynamic storage 

Deallocate dynamic storage 

Check to see if file should be purged. 


CLI qualifier bitmap 
ber of versions to save 
Number of files pu rged 
Size of file being deleted 
Number of blocks released 
Context longword for common qualifier package. 
Return status code from common qualifier package. 
Return status code from common qualifier package. 


Address of Linked List of versions 


Number of versions seen so far 
Length of previous name & type 

er to hold previous name/type 
Length of previous directory 
Buffer for previous directory 


$3 
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GLOBAL ROUTINE purge_files (fab_block) = 


ee 
! Functional description 


and the qual values saved. 
Calling sequence 


Output parameters 
None 
Routine value 
Status. 


' 
4 
t 
i 
i 
i 
i 
) 
i 
i 
i 
: Input parameters 
i 
i 
i 
1 
i 
i 
4 
i 
i 
i 


BEGIN 


fab_block: REF $BBLOCK; 


BIND 

nam_block = .fab_block Cfab$l_nam]: SBBLOCK; 
LOCAL 

status, 

devnam_desc : vecronted. 

itmist : VECTOR[4, LONG), 

buffer : INITIAL(O); 
IF ((NOT = SoOL OCKt fob biock pfebst dev . dev$v_dir)) 
AND (NOT .SBBLOCK( fab_block Cfab$l_dev], dev$v_netJ)) 


THEN 
RETURN false; 


Ay -SBBLOCK(fab_block Cfab$l_dev], dev$v_net)) 


devnan_desc{03 - “nan block inead dev}: 


evnam es -nam_block(nam$\_dev 
talst2 >= 4; 
itmlst<16,16> = dvi$_acptype; 
tmist{i) = buffer; 
itmlst = Q; 
italst = 0; 
status = SGETOVIW (DEVNAM = gevnan desc, 
ITMLST = itmlstd; 


This routine performs all the main processing of the 
PURGE commend, ine command Line has already been parsed 


purge_files(fab) from the DELETE command mainline code 


fab_block = Address of FAB with FNA, FNS filled in. 


Address of FAB block 


Address of NAM block 


If not a directory device, 
and not a network device 


If not a network device 
then check to see if 
we are purging an ODS-2 disk. 


P 4 
RCIPURGE.832:1" (3) | 


an 
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RG 14. -S$ep-1984 VAX-11 Bliss-32 V4.0-742 
y0e e800 seagee ORs FST tg ea thle tea bec ere Sacapunce.es2nk”* « 
: 189 9 IF NOT .status 
3 188 38 THEN 
3 391 94 SIGNAL_STOP (.status); 
: 138 95 END; 
; 196 3 IF pul tor EQL ous acp_f ! If this is an ODS-2 disk 
: 195 98 THEN purge_ods2_Tiles (tab block) ! then use optimized purge routine 
3 136 99 eee uild-LlistT. tab. _block) ! else, use old one. 
:; #19 00 
; 64198 3 RETURN true; 
: 199 0302 END; 


-TITLE PURGE 
-IDENT \V04-000\ 


.PSECT SOWNS,NOEXE,2 
00000000 00000 VERSIONS: 
00000000 00004 PREV_NAME LEN: 
00008 PREV_NAME: 
LKB 


00107 “BLKB 
00000000 00108 PREV_DIR_LEN: 


» 
0010C PREV_DIR: 
BLKB 255 


-PSECT $GLOBAL$,NOEXE,2 
00000000 00000 VERSION_LIST:: 
«LONG 


0 5 
-EXTRN DELSSEARCH_ERROR 
~EXTRN DELSFILE ERROR LIBSFILE SCAN 
-EXTRN LIBSSET_ERASE stay T oTB 
SEXTRN LIBSGET-VM ties EE. 
SEXTRN LIBSQUAC_FILE_M 
~EXTRN SCAN_CON ONTEXT. EL Cu STATUS 
SEXTRN DELSREEPVER_VAL 
eEXTRN DELSFILES DELET Tep 
eEXTRN DEL Fite SI2E, iz LSBLOCKS_DELETED 
~EXTRN DELSCONTEXT, QUIPR 
-EXTRN LIBS_F PT LFAIAAT. Oe rssce ToVIW 
-PSECT SCODES,NOWRT,2 
0004 00 sENTRY ait. SF FILES, Save R2 3 0235 
18 C SUBL 2 : 
0 ag D MOVL tock 3 0267 
8 Ae 0 MOVL cOcne) Ro * ; 
7E D4 CLRL 3 
97 40 A E f BBS . "ehang», 1$ : 0275 
§ 41 OA f 14 BBS ; . 65(R2), 2 : 8 
6 19 BRB 5$ ; 027 


| 


Se URG GO, ERIE 
vou=600 iebeocsgs 3:98:45 McD MBAS 


2 v4. 
a bei ere SRcIPuRGE.e3204°" (39 


Dus 


38 41 0S £0 1$: BBS #5, 65(R2), 28 : 
a oe am it bin ate : 
g4 00420004 af MOVL #32 bo LTMLS] ; $ 
r) MOVAB FFER [TMLST+4 3 
oc A CLRO oY 18 ; | 
, CLRQ 0 =( SP) : 0291 | 
C ( CLRQ 0s = SP) ; | 
16 AE OOF C PUSHAB ITMLST : 
28 «AE OF PUSHAB DEVNAM_DESC : 
7E 7¢ CLRQ. =< SP) : | 
000000006 00 re CALLS #8 SYSSGETDVIW ; | 
E ¢ BLBS star US, : 0 92 | 
DD F PUSHL Tus + 0294 
000000006 88 4 1 CALLS LiBssrop 3 | 
p 8 2% CMPL gut Vb R, ; 0297, 
é B BNEQ $ 
DD D PUSHL Re > 0298. 
0000v CF Fe F CALLS #1, PURGE_ODS2_FILES F | 
, ; BRB 4$ 3 
2 DD 6 3S: PUSHL R2 + 0299 
0000v cf 4 FB 5 CALLS #1, BUILD_LIST : 
0 1 BO 0060 48: MOVL #1. R + 0301. 
00 RET ; 
50 04 00071 5$: CLRL R : 0302 
04 RET : | 


; Routine Size: 116 bytes, Routine Base: S$CODES + 0000 


200 0303 1 


Se 


v002600 1§-beo-1984 13:48:08} SEERSUMGMASTERSEOELE TE “GRCIPURGE.B32017" (4) 


; ROUTINE build_List (fab_block): NOVALUE = 

: ‘ RE 

: } : Functional description 

: 1! This routine is we : an action routine from the directory wildcard 

; 1! sqerentan process. iven °, FAB containing the full name 

ae 4. 1! of the file to be praccesel. It_is ueee when purging an ods-1 disk to 

; } Z : : build the filenames into an ods-2 | 

; 1§ 5 Input parameters 

; i 5 ; : fab_block = Address of FAB 

; 7 ; i Output parameters 

; i 1 None 

; 5 5 2 BEGIN 

3 225 $ 

: $ $ fab_block: REF S$BBLOCK; ! Address of FAB 

; 0 2 BIND 

3 1 nam = .fab_block Cfab$l_nam]: SBBLOCK; ! Address of NAM 

$231 : LOCAL 

3 § status, ' Status code 

; 5 dir_len, ! Length of covice/directory 

; version, ! Version number in binary form 
3 5 Length, ' Length of new version entry 
; entry: REF VECTOR, ' Address of new version entry 
} prev REF VECTOR, ' Address of previous entry scanned 
g ; ? curr: REF VECTOR; ! Address of current entry scanned 
240 ; 

3 41 ' If we have reached a new Stree tery then peruse the Linked 

3 : : List of versions and delete the all but the # explicitly kept. 

: 266 ; 

3 ve : dir_ten = .nam (nam$b_node) + .nam (nam$b_dev] + .nam (nam$b_dir); 

: 26 3 IF CHSNEQ( ' If new directory 

; 24 ? “prev, dir_len, prev dir, 

; rh ; . -dir_Ten,~.nam Cnam$l_rsaj, 0) 

: 1 

3 : 4 CHEROVE C. -dir_ jen, a Cram$l rsa), prev_dir); 

; 5 prev_dir_len'= .d 

3 r § purge. _0ds1 yg Pe, List); ' Delete old versions 

es ae 

3; 238 0 ! Convert the version string to binary form 


ré 


status = LIBSCVT =PTBC an nam a eh -1, 
am tnam$l_verJ* 
coratents 
UA NOT .status 


NBEGIN 

51 SNAL (.Stetus)s 
RETURN; 
END; 


then by version in descending order (this 


Le th = 6*4 + ,nam (nam$b_rsl); 
He wwe = LIBSGET neaClonathcontes) 
Status 


SIGNAL _STOP(.status); 


entry f +. -nam Coons. name) + .nam Cnam$b_type); 
entry (2 : entr 
3) (.nen Enandt _name) - .nam Cnam$i_rsa]); 
entry -vers 
entry nam Cnasb rslj; 
= s entry 
Sabvec nam HAS Jeu, -nam Cnam$l_rsal], entry (6)); 


prev = version arete 
curr = .prev (0 


WHILE .curr NEQ 0 
d0 


PEA qenoer"ys 
CHSCOMPARE ¢.enery (1), .entry (2), 
curr (1), .curr 
IF “comer son ss 
-compa 
i AND sentry [3)' 6 Grau cure (3)) 
EXITLOOP; 


prev = .curr; 
cure = .curre (0); 
ND; 


t 7 Rs (0); 
vet  sanaene 
RETURN; 

END; 


ibeorage 3:78: 


VAX-11 Bliss-32 V4.0-7 


Store version in binary 


If error converting value, 


! signal the error 


Add this version to the ordered Linked List of files for this directory. 
This List is ordered first by file name & type in ascendin orger. and 
s the same as ODS-2). 


Length of overhead plus filespec 
Allocate storage for entry 

If error allocating storage, 
then signal the error 


Length of name/type 


! Address of name/type 


Store poet ie version number 
Store lengt lespec 
and address of "slice 
Store full filespec 


Address of previous entry 
Start at first entry 


For each entry in List, 


-1 if less, 0 if equal, 1 if greater 


Compare new to old name/type 

If found place to insert entry, 
(ascending order by name/type, 
(then descending order by version) 


then exit the loop 
Save address of previous entry done 
and Link to next in List 


Make new entry point to next in List 
Make previous entry point to new one 


P 
DISKSVMSMASTER: (DELETE. “Sac JPURGE.B32;1°° to 


——a 


| eee = eG Gree ee an pang pipes. 


- -| A iss 4 
12=ge= 1882 $337 DIEKSVMGMASTERSEOELETE SRCIPURGE .B3204°" (4) 


O1FC 00000 BUILD_LIST: 


.WORD Save R2,R3,R4,R5,R6,R7,RB + 0304 
4 0000' cf ROVAR PREV_DIR_LEN, RB : 
C SUBL2 #12,°SP : 
A MOVL FAB.BLOCK, RO + 0331 
A MOV O(RO), R? : | 
0 a MOVZBL g(R ); RO + 0347) 
1 A7 MOV gL (R7), R : 
0 51 ADDL2 R17, RO : 
6 3A oA? MOVZBL 38(R7) DIR_LEN : | 
$ 5 ADDL2 RO, DIA_LEN : | 
56 00 06 A - 6 CMPCS PREV_DIR_LEN, PREV_DIR, #0, DIR_LEN, @4(R7) ; 0349) 
12 BEQL =s«1S ; | 
04 as 046 87 2 MOVC3 DIR_LEN, @4(R7), PREV_DIR + 0354 
6 6 MOVE DIR“LEN, PREV v_DIR_LEN : 0355 
0000° CF PUS VERSION. LIST : 0356 
0000v CF 1 CALLS #1, PURGE_ODS1_DIRECTORY 3 
f PUSHL SP : 0363 
7E 54 OAT 0 ADDLS = #1, g4(R7) -(SP) : 
7E 3D OAT MOVZBL 61(R7), -(§P) + 0363 
6f DECL ($P) ; 
000000006 0: CALLS #3, LIBSCVT_DTB ; 
6 VL RO, STATUS : 
OA BLBS STATUS, : 0366 
PUSHL STATU : 0369 
000000006 00 01 CALLS #1, LIBSSIGNAL oe 
08 AE 03 A? MOVZBL 3(R7), LENGTH : 8398 
08 AE 18 ADDL2 #24, LENGTH : 
; 4 AE PUSHAB ENTRY : 0380 
Cc (OA PUS LENGTH : 
000000006 CALLS #2, LIBSGET_VM ; 
MOVL oR TATUS : 
0 BLBS = STATUS, : 0381 
PUSHL STATUS : 0383 
000000006 00 CALLS #1, LIBSSTOP : 
6 4 AE VL gNtRY Rb : 0385 
A MOVZ2BL 59(R75, RO ; 
1 € a? MOVZBL GOR?) R1 : 
9 51 ADDLS Ri, RO. 4 (RG) : 
ac A 0 A? SUBL3 4(R7), 76(R7), RO : 0387 
0 A6 8 A046 MOVAB 24 (ROSERO] BiR6) ; 
¢ A6 MOVL ERSION 3(R6) : 0 
10 A6 9 A MOVZBL 3(R7), 16(R6) : 0389 
4 A A MOVAB 24(R65, 20(R6) ; 
5 03 A mOVZBL (R7), R : 0391 
04 50 mMOVCS RO, @4(R7), 24(R6) ; 
? 0000" CF MOVAB VERSION_LIST, PREV : 0 93 
4 ? MOVL (PREV), "CURR : 0394 
8 BEQL i : b7e8 
55 1 MOVL #1, RS 3 
08 86 04 Ab CMPCS 4(R6), @8(R6), #0, 4(CURR), F 


1bcben-19 13:78:28 — DESKSUMGMASTERSCDELETE SRCIPURGE.B32-4%" (45 


i 


y i. RS 
58: MOV Ree COMPARISON 


CMP Tne, 12( CURR) : oe 
CURR, PREV : 
(CURR) , CURR : 
4 : 03 
(PREV), (R6) : 
R6, (PREV) : 


Routine Size: 247 bytes, Routine Base: SCODES + 0074 


| , es 
o 
oO 
vw 
SS FN F SE 
So 
s = 
VOUVSMNDS PO—-MOOW 
SUSFFSSLABLALT 
SSS3=—SSs—eneoa> 
oo-oo,y Pd 
sssssssss 
— 2S SS = S 
oo 
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-Sep- 239:44 ° ° -O- 
1SoSeont984 13:78:28 — DESkSvMGMASTERSCOEL ETE SRcJPURGE.B3264°" <4) 
GLOBAL ROUTINE purge_odsi_directory (List) : NOVALUE = 


tee 
: Functional description: 


This Foyt ive purges all versions beyond the number explicitly kept for 
an ods-1 directory. 


list = Address o Uigthees of version List 

) Link to next entry 

-2) descriptor of file name & type 
on number in binary 
4-5) descriptor of filespec 


' 

1 

4 

4 

1 

4 

i 

! 

: 3) vers 
: 6) File specification follows 
t 

t 


NAM used for deleting open files 

XAB needed for common qualifiers package 
XAB needed for common qualifiers package 
FAB used for deleting versions 

Chain XAB‘s to FAB. 


: SXABPRO(), 
xabdat: SXABDAT(NXT = xabpro), 
: SFAB(NAM = nam, 
XAB = xabdat); 


v 


RRRRLRLLLLLRLRLKRLLRLLLLELLKLLKE = RLLKLLRRRRERPERERRE REE 


BPEL EEE EE 


tus, 
rev_name: ECTOR 


prev_ : V i. Descriptor of previous name & type 
ios percent VECTOR Cnam$c_maxrss, BYTE), 


Buffer to hold previous name/type 
Length of current entry 

Current entry in List 

Next entry in List 


entry: REF VECTOR, 
next; 


DOONAN E WO OONOAU EW OO OO 


prev_name (0) = 0; 
entry = ..list; 


WHILE .entry NEQ 0 
dO 


Initialize previous name/type = null 
Start at first entry in List 


For each entry in List, 


GIN 
°F LHSNEQ(. rev_name oe -prev_name (1), 
ahh eentry 3; 0) 


entry If new file name & type, 
THEN 

BEGIN 

voretons = 0; 

context(0) = 0; 

prs case ENN s seen Sia 

v = v : 
HSMOVE (. entry cf5s Tentry (2), -prev_name (1)); 


Reset number of versions seen 
Prevent confirm messgae. 
Save ‘‘current’’ name type 


Be Se Se Se Fe Se Se Se Se Se Se Se Se Se Fe Se Se Ge Se Ge Se Fe Fe FF Se Se Se Se Ge FH Se Se Fe Se Se Se Se Se Ge Ge Se Se Se Se Se Se Se Ge Se Ge Ge Se Ge Se Ge Se oe 
- 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
BEGIN 
BIND context = .del$context : BITVECTOR(32); 
& 
4 
4 
4 
4 


verreots 


w 


BISRRAN= 


END; 
fab fabSb_fns) = .entry (4); 
fab [fab$i"fna] = .entry (5); 
nam [nam$b_rsij = .entry 14); 
nam (nam$i"rsa] = .entry : 
purge _this_file(fab); 


Delete the storage used for this version entry 


next r 
eet 
sFe cue 


sentry 


0); 
ate 


2 Pow FREE etal vcnath entry): 


CM IGNAL(. status); 


entry = 


list = 0; 
END; 


next; 


ep-1 
b-fep-t 


9c f2:18:48 — DISSungnas tens CDELETE- 


Copy lt need and address 
of str into FAB and 
NAM bloc s. 


Save address of next one 
Length of entry 

Delete storage for entry 
If error deleting storage, 


then only signal the error 
Link to next in List 


Re-init Listhead 


SOWNS ,NOEXE 2 


, 


i} 


C2] 


t gacapuRGE.B3261°" «35 


— 


coo 


ee ee nn en en ee ee 


ASP NOOR TOSSAASS UR REA EE PERS IeS 


>_> _+_+_+_+ 


- 
- 


Tele 


2s 


XABDAT: 


+++. 


2s 


2s 


2s 


++ o> 


sc 


++ 
i] 
® 
oe 


++ _+L + 


ee oe eee 


a 


ae 


=== 


ibodeont9ge 33 


see 
2 mam a8 
o 2 


[ on 


Gosae @ow 
<<o<< 
> oe an oie ee) 
ommommeo 


B8 


Bis Di Seénsnas 


4 
1 
4& 
0 


“ADDRESS XABPRO 


iter: 


ae cDELeTE SRCIPURGE 83204" df 


3; Routine Size: 


00 
FC 3=—sBD 
04 AE 


139 bytes, 


000000006 33 


" 
13-Sep-1984 43:18:68 DISkSUMGHASTERSCDELE TE SRCIPURGE.B3204"" (45 


¢ 

A 

000000: C 
03FC 00000 


5 oooobbite $5 
06 ec D 


56 
FC 3=sBD 


000000006 00 


Routine Base: 


a 


tf 


08 


SCODES + 0168 


pear erred 
rr Oe eh er 


a" 
we 
oo 


3$: 
4$: 


-ENTRY 


SCODES ,NOWRT ,2 


CyPEs -£85! DIRECTORY. Save R2,R3,R4,R5,R6,- 
R7,RB,R 


~268( SP) SP 
DELSCONTEXT, RO 
PREV_NAME 


acis 
ENTRY, R6 


PREV_NAME, @PREV_NAME+4, #0, 4(R6), @8(R6) 


PREV_BUFFER, PR 


1, PURGE_THIS_ 
R6), NEX 
24, 16(R6), LE 
NGTH 
#2, LIBSFREE. VM 
STATUS 
STATUS, 3$ 
AT 


E 
EV_NAME +4 
@PREV_NAME +4 


FILE 
NGTH 


Sete Se Ge Se Se Se Ge Se 


ST 
#1, LIBSSIGNAL 
NEXT, ENTRY 


a_Ist 


; 


ZKVYANYVMNOYNNKOYNNNVOVOVEECF CCK KMmMnE 


mo 


11 
15-5 -1984 23:39:44 VAX-11 BLiss-32 V4.0 
12-80 8-19he $337 248 DISKSVMSMASTER: CDELETE.SRCIJPURGE .832 


$3 
s" 


: i } ROUTINE purge_ods2_files (fab_block) : WNOVALUE = 

; 401 1 1 t+ 

; ¢ ¢ § } Functional description: 

3 604 1/ This routine purges all versions beyond the number explicitly kept for 

; pet 5 } } an ods-2 disk. 

; rh 507 1! Inputs: 

; 408 2 : 1! 

3 ret : ! fab_block = Address of FAB 

; ait y i Outputs: 

; a1 i§ 1! None, the old versions are deleted. 

; 416 514 1 lene 

; 415 si? 1 

: $i$ BEGIN 

3; 41 51 

; 418 0518 MAP 

3 419 0519 fab_block : REF S$BBLOCK; ! Address of FAB 

: 5 0331 Bin 

: 4 § 5 ¢ context = .del$context : BITVECTOR(32), ! Context bitmap for common qualifier package. 
3 : t Be ? nam = .fab_block Cfab$l_nam] : SBBLOCK; ! Address of block. 

: 425 03 5 2 LOCAL 

3 : $ 3 $ name_len; ! Size of a filename. 

: 428 528 

; 429 5 name_len = .nam prente node + .nam Cnam$b Seve + .nam Cnam$b_dir] + 

3 2 : ; ? enam Cnam$b_name] + .namCnam$b_ftyped; 

; 6 § 5 § IF CHSNEQ( ! If new device, directory, name or type 
; § 5 -prev_name_len, pres name, 

3 4 5 -name_len, .nam Cnam$l_rsaj, 0) 

H 2 5 b2 5 THEN - ! Then 

3 4 $8 CHSMOVE(.name_len, .nam Cnam$l_rsa), prev_name); ! Save new file spec, 

3; 4 be prev_name_len = .name_len; ! and its size. 

3: 439 5 versions = 1; ' Reset the version count. 
3 0 B2 context(0) = 0; ! Disable /CONFIRM. 

3; «441 03 RETURN; 

; $ 

3 03 purge_this_file(.fab_block); ! Attempt to purge this file. 
; 5 END; 


O1FC 00000 PURGE_ODS2 FILES: 
Save R2,R3,R4,R5 


ing A ee 


5 
2 


H oooo8888; 65 5 SN =u EF eat esa 


Vv 
4 
7 
7? 
7 
7 
7 
7? 
7 
7 
7 
7 
7 
7 
7 
7 
7 


1%. -1 24 VAX-11 BLis $-32 V4.0-742 

y2=ReP 38S 93:98:28 step TERSCDELETE SRCIPURGE.B32c1°" (os 

5 ‘ae 06 MOVL FAB ae oCK : 0523. 

4 B MOV (R : 

: Aa 9A 0001 MOVZBL (Ra). y + 0529) 
AG 9A OOOIA MOVZBL 57(R4). R : v 
0 51 CO ADD RO’ : $ 
1 3a AG OGA MOVZBL 58(R4), R1 : i 
0 51 CO ADDL R : 1 
1 38 «AG OGA MOV gL 59iR4), RI t 0530) 1 
0 51 CO C ADDL R + 0529 N 
6 3¢ As A f rites é (Rr4) NAME . LEN : 05 nN 
56 00 04 a8 “ és D : CMPC PRE y HARE. LEN, PREV.NAME, #0, NAME_LEN, = 0532 | N 
11 BEQL Ss} F N 
04 as 04 B84 i 2 ip MOVC3 NAME_LEN, @4(R4), PREV_NAME : $37 U 
6 6 D0 4g MOVL §§NAME“LEN V_NAME_LEN : 05 1 
FC OA oi 4 MOVL #1, VERSIONS + 0539 ” 
6 1 s 4p 81 C82 wi, (R7) ; 540 E 

55 DD 00051 1$ PUSHL RS + 0544 

0000v CF 01 FB 0005 CALLS #1, PURGE_THIS_FILE ; 
04 0005 RET + 0546 


; Routine Size: 89 bytes, Routine Base: SCODES + 01F6 


11 
- ° 4 2 : - - 0- 
1Frseo 19g 13:18:48 DISKSVRGMASTERSCDELETE SRCIPURGE.83251°" (7) 


v04=600 


IF .del$cli_status get $v_log_msgi OR ! If /LOG requested. 


$36 gdetSel it status del$v_open_f or open_file bit set 

rH BEGIN 

4 fab Ltopst alg) = 0; ' Set block size of file to be zero because 
490 SOPEN (FAB = fab); ' Open the e. 

491 del$file_ size = .tab (fab$i_alq); i Get block size of file. 

$3 END; 

494 If -delScli_stetusldel$v gent pronpt } ! If user said /CONFIRM ang 

495 AND (.versions fot gel keepver_val) i “we have exceeded /KEEP Limit 

« THEN context(0) = 1; ! then enable /CONFIRM option. 


status = Asetquel_file_nerct elScontext,fab,0, Does this file meet purge criteria? 


SESESESS= 


escriptor(''AS, delete? (NJ:"), 
prompt _desc,0); 


ay Status ' If failure status returned, 


BEGIN 


: is tf } ROUTINE purge _this_file (fab_block) : NOVALUE = 

: 4 49 1 te 

: 2 1 ! : Functional description: 

: 6 i 1 This routine accepts a filename, and if it exceeds the /KEEP qualifier, 

: ¢ : ? : : attempts to delete the file. 

; 4 $ 5 1 ; Inputs: | 
; isp ; § fab_block = Address of the FAB 
3 4 ii Outputs: | 
3; 461 2% 1! 

: re 22 : : None, the file is deleted if /KEEP qualifier is exceeded. 

> 664 208 ~ 

3; 465 564 BEGIN 

3 £66 565 

; 46 206 

; ree | 4] fab_block : REF S$BBLOCK; 

: 470 56 BIND 

3: 671 570 context = .del$context : BITVECTOR(32), 

; 47 571 nam = .fab_block Cfab$l_nam] : SBBLOCK, 

3; 47 276 fab = .fab_block : SBBLOCK; 

3: 476 57 

: tee re eg de ' Add f t t 
3 desc, ' ress of prompt arguments 
3 477 g278 name_desc : VECTOR(2), ! Descriptor for File Sees. 

: $78 He status; 

: 4680 278 name g00e hte = ,nam(nam$b_rsi); ' Save file name and size. 

; 481 5 name_desc(1]) = .naminam$l_rsal; 

; 4 § 581 prompt _desc = name_desc; ! Point prompt_desc to it. 

; 48 5 § 

3 5 

3 5 : 

3 ; 5 ! 

: T 

; 5 

Py 5 ‘ 

3 ; : 

; ) 

3 T 


WIN 


--———_—_-- 


11 
eo geoet ake 13:18:48 DI SRSVMGMASTER-CDELE TE SRCIPURGE 03221" B 


voa=600 


BEG 
fab Etabsy dit) 


14-Sep- 
5 If .status EQL Lib$_quipro ! If user said CNTRL/Z 
5 ! then stop processing. 
0 LScli <pratus semtiay enter 5 stop) = TRUE; 
o8 If Rag to ae ! if user said CNTRL/Z 
(.status NEQ Libs vite ee ! or file did not meet criteria 
10 N ! then do not report an error. 
11 1 gol St ite aerror (msgs. filnotacc, fab); 
1, 12 SCLOSE (¢ fab); ! Ask RMS to close the file. 
14 1 
16 \3 versions = .versions + 1; ! Increment versions seen 
1 1 
18 i IF (.versions GIR .delSkeepver_val) AND .status ’ : best ppec ttied Limit, 
19 \8 THEN i “then delete the file as we have exhausted 
0 061 BEGIN ! the kee ienten count. 
1 89 0 If .del$cli_status Cdel$v_erase] ! If /ERASE requested 
¢ 1 og 
4 08 5 SCLOSE (FAB = fab); ' Close the rite. oo that we cn do it. 
5 4 status = Lib$set _erase (name_desc); ' Set ERASE bit in header. 
6 5 fabCtans sts] = ,status; ! and save the status. 
7 6 fablfab$i-stv) = 0; 
SRS a 
IF .status ! If successful so far, 
31 0680 : 
3 0631 BEGIN 
06 § If .fab Cfab$Sw_ifi] NEQ 0 ! If the file is open, 
34 06 THEN 
BORE 
Oe 
06 


Be Se Be Oe ee Se Se Se Se Se Os Ge Se Se Se Se Se Se Se Ge Fe Ss Se Se Se FF Se Se Se Se Ge Se Se Ge Ge Se Ge SS Ss Se Se Ge SH SH Se FHSS Se G4 Se Se Se Se See Ge 
Py awh ah al tah ah sh ah Ah ah ah sb dh dh db dh db db bh dh bb dh th db dbedbedh Abedb uhh Ab bb db Ah Ah Ah Ab bb ebb Ah Ah ah Abb hh dh dh dh ah hh Ah sh dh hh ah Ah A) 
RIP IIR IB BE DVD Bh BB TI BB INNS BB EN PPINIPININI IIH Ort 
m 
r 


36 = TRUE; ! then set the deletion bit, 

37 status = STLOSE ( FAB = fab); i and ask RMS to close and delete the file 

$ , 3 fab$Sv_ditj] = FALSE; i turn off the delete bit to avoide side effects. 
40 :] 

dg re am status = SERASE ( FAB = fab); ' Erase the file. 

4 e 

re} eas if zstetus ! If successful, 

“6 45 BEGIN 

2 ré IF “BEGIN status Cdel$v_log_msg]) THEN ! If logging requested, 

rk 3 del$files_deleted = ode Stites deleted + 1; isiitersize number of files purge ed 

50 del$blockS_deleted = .del ae locks_deleted + .delstite ze; ' Increment total blocks deleted by t 
51 P 0650 put_message (msg$ Htees name_desc, ' Output log message 

3 51 .delStile size); 

2¢ END; 

a} az ELSE 

23 36 . del $tile_error(msg$_filnotpur, fab) ! Delete failed, output message giving reason 

5 o 

$3 iH SCLOSE (FAB=fab); ' Make sure file is closed! 

61 0 END; 


=m I 


tasarnrre] 1 2 


1Sdeo-19Re 25:39: 


«PSECT 
ASCII 
-BLKB 


6E 5B 20 SF 65 74 65 6C 65 64 20 2C 53 $i $i P.AAB: 


64 VAX-11 Bliss-32 V4.0-742 
48 DISKSVMSMASTER: CDELETE.S 
SPLITS,NOWRT ,NOEXE,2 


\!IAS, delete? (NJ:\ 


fF 
11 
opo00n1), ROUTE P.aaa: tONE 17 


“exten 
~EXTRN 
«PSECT 
OFFC 00000 PURGE _THIS FILE: 
WORD 
8 , 0 MOVAB 
A 9E 0 MOVAB 
9 9€ He MOVAB 
; 9 9001 ROVAB 
g 9E $0 § MOVAB 
9E QO02A MOVAB 
4 9E— 00031 MOV 
Ce 000 SUBL 
6A 00 000 MOVL 
4 AC D 4 MOVL 
; A 4 4 MOVL 
E A A Boe MOVZBL 
04 AE 4 ad 00 4A MOVL 
5E D Boe, PUSHL 
04 64 0 § 51 BBS 
64 Bnee TSTB 
10 18 000 BGEQ 
10 Ag D4 3 9 1%: CLRL 
52 DD 0005C PUSHL 
000000006 00 01 F bas CALLS 
66 10 A2 D 106 MOVL 
08 64 06 €E 069 2%: BBC 
67 68 9} 060 CMPL 
0 BNEQ 
63 1 8 B1SB2 
E 3$: CLAL 
: AE 9F PUSHAB 
0000" cr F PUSHAB 
3 D4 CLRL 
dO PUSHL 
A 00 PUSH 
000000006 F CALLS 
D MOVL 
1 3 BLBS 
4 MOV 
9 CMPL 
BNEQ 
64 8 B1SB2 


SYSSOPEN, SYSSCLOSE 
SYSSERASE 


SCODES ,NOWRT ,2 


R2 


re 
ag 


AO—Oowm— 0-—-0O 
= 
@D 
—~ 
~ 


SYSSOPEN 

(r2), DELSFILE SIZ 

DELSCLI_STATOS, 
RSIONS, DELSKEEPVER_VAL 

es (3) 

PROMPT DESC 


-(SP) 
R 


wc 8B o =CHaASEmemamm—mmmne 
og ~~NROOmw 


R10 
age LIBSQUAL_FILE_MATCH 
R STATU 

STATUS, 6 

LIBS QUIPRO, RO 

piATOs, RO 

i, DELSCLI_STATUS 


Pete Se Ge Ge Ge Se Se Se Ge Se Se Se Se Se Ge Ge Ge Se Se Ge Ge Se Se Se Se Be Se Se Se Se Se Se Se Se Se Be Se Se Be 


0547. 


ViViViviwa ww 


“aS SB ARSSS xs 


oo COO CoO COCOCOO CO 
> 


vw Ow oF=u 


“oo 00 oO 
Nw 


OS 


12 
1$-36 =1984 23:39:44 VAK=11 Bliss-32 v4.0-742 Pp 0 
ye 500 12-88-19 13:73:06 DISKSVMSMASTER: DELETE. SRCIPURGE.B32:1> (3 
50 9 C 48: MOV L1B$_QUIPRO, RO : 0607 
Ho gfArOs. RO é 
50 000000006 9 MOVAB LIBS_FILFAIMAT, RO + 0608 
p CMPL g{AT0s, RO 3 
dd posta, hk ? 0610 
00931338 8F DD PUSHL # 638712 : 
69 FB CALLS #2, DELSFILE_ERROR : 
DD 5$ PUSHL R + 0611 
65 Fe CALLS #1, SYSSCLOSE : 
21 BRB 7$ + 0601 
68 DO $$ INCL VERSIONS : 0614. 
67 i : & CMBL VERSIONS, DELSKEEPVER_VAL : 0617. 
7D E BLBC «STATUS, 13$ F 
19 64 4 €1 BBC #4, DELSCLI_STATUS, 8$ : 9620 
é DD PUSHL Re : 0623. 
65 01 FB CALLS #1, SYSSCLOSE ; | 
06 AE OF PUSHAB NAME_DESC 0624 | 
000000006 99 1 F CALLS #1, CIBSSET_ERASE ; 
9 1) MOVL R 3 
08 A2 D MOVL STATUS, 8(R2) : 
Oc A2 D4 CLRL (R2) : 06 
52 53 £9 8$: BLBC TATUS, 12$ : 06 
02 A a TSTW (R2) : 06 
14 BEQL $ 3 
0S A2 80 ef 8 BISB2 #128, 5(R2) + 063 
é DD r6 PUSHL R + 0636. 
$5 FB F CALLS #1, SYSSCLOSE : 
3 0 pore MOVL 3 
0S = A2 80 8F 8A O0OF BICB2 #128, 5(R2) : 063 
Q 1 0010 BRB 10$ > 063 
DD 00105 9s: PUSHL R + 064 
000000006 99 g FB 001 CALLS #1, SYSSERASE F 
9 D0 001 MOVL RO STATUS F 
2a 53 €9 00111 10$:  ®BLBC STATUS, 1 3 064 
31 64 o1 E1 00114 BBC , DELSCLI_STATUS, 13$ > 064 
000000006 00 06 00118 INCL  DELSFILES DELETED > 064 
50 D 11 D LSPILE SIZE RO > 064 
000000006 00 CO 001 ADDL2 RO, DELSBLOCKS_DELETED : 
bp 0128 PUSHL R : 0651 | 
08 Ar F OO12A PUSHAB NAME_DESC ; 
) DD 0012D PUSHL #3 : 
00931318 BF DD OOleF PUSHL #9638683 : 
000000006 00 4 Fe 0135 CALLS #4, LIBSSIGNAL : 
8 11 0013C 118 BRB 13$ > 064 
DD 0013€ 128 PUSHL R : 065 
00931230 8F DD 0014 PUSHL #9638448 : 
69 FB D146 CALLS #2, DELSFILE_ERROR : 
DD 00149 13 PUSHL R + 0658 
65 FB 00148 CALLS #1, SYSSCLOSE : 
04 0014E RET > 0660 


; Routine Size: 3355 bytes, Routine Base: S$CODES + 024F 


1-Sep-1984 23:39:44 VAKoIT BLisec$2 v4.27 
18-$p-1984 93:33 DLEKSVMGMASTERSCOELETE SRCIPURGE 832-1" (3) 


~-EXTRN LIBSSIGNAL, LIBSSTOP 


; PSECT SUMMARY 

: Name Bytes Attributes 

: $GLOBALS 4 NOVEC, WRT, RD ,NOEXE.NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) 
3 § 2 NOVEC, WRT. RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) 
3; SCODES " $ NOVEC.NOWRT, RD, EXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) 
; SPLITS ; NOVEC, *“NOWRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) 
; Library Statistics 

: weer woes Symbols @eeoeee- coe Pages Processing ca 

: File Total Loaded Percent Mapped Time 

; -$255$0UA28: CSYSLIBISTARLET.L32;1 9776 85 0 581 00:02.3 

; COMMAND QUALIFIERS 

5 BLISS/CHECK=(FIELD, INITIAL ,OPTIMIZE)/LIS=LIS$:PURGE/OBJ=0BJ$: PURGE MSRC$:PURGE/UPDATE=(ENHS$: PURGE) 
; 565 8665 0 

3; Size: 6 ode ¢ 864 data bytes 

3; Run Time: 744.7 

: Elepsed Time: 55.1 

3; Lines/CPU Min: : 

3; Lexemes/CPU-Min: 1257 

; Memory Used: 147 pages 

3: Compiiation Complete 
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C 
C 
¢ 
C 
C 
C 
C 
C 
C 
C 
C 
C 
Cc 
C 
C 
Cc 
C 
C 
Cc 
Cc 
C 
C 
C 
C 
Cc 
C 
C 
C 
C 
Cc 
E 
E 
I 
L 
L 
L 
L 
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010 AH-BT13A-SE AL: EQUIPMENT CORPORATION 
VAX/VMS V4.0 


DENTIAL .AND PROPRIETARY 


DIGIT 
CONFI 


